home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / Dynamic Re20794682001.psc / clsBitmap.cls next >
Encoding:
Visual Basic class definition  |  2001-01-07  |  3.3 KB  |  126 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "clsBitmap"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = False
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15.  
  16. ' Credits:
  17. ' Based on Steve McMahon's work (vbAccelerator.com).
  18. ' I removed some code that's unneeded for this demo,
  19. ' cleaned it up a bit and added LoadResource().
  20. ' It's a great, simple, general-use class.
  21.  
  22. Private mDC As Long         ' Memory DC
  23. Private mBitmap As Long     ' Bitmap handle
  24. Private mOldBitmap As Long  ' "Original" Bitmap handle
  25.  
  26. Private mWidth As Long
  27. Private mHeight As Long
  28.  
  29. Public Function LoadFile(FileName As String) As Boolean
  30.  
  31.     ' Clear up previous DC/bitmap
  32.     ClearAll
  33.     
  34.     mBitmap = LoadImage(API_NULL_HANDLE, FileName, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE)
  35.     
  36.     If (mBitmap <> API_NULL_HANDLE) Then
  37.         LoadFile = LoadBitmapIntoDC
  38.     End If
  39.     
  40. End Function
  41.  
  42. ' Note: that function will NOT function properly when the
  43. ' project is run under the IDE, because then the resources
  44. ' loaded will be VB's resources, not your app's resources.
  45. ' You may want to watch some interesting side-effects though...
  46. Public Function LoadResource(ResourceID As Long) As Boolean
  47.     
  48.     ' Clear up previous DC/bitmap
  49.     ClearAll
  50.     
  51.     mBitmap = LoadImage(App.hInstance, ResourceID, IMAGE_BITMAP, 0, 0, LR_DEFAULTCOLOR)
  52.     
  53.     If (mBitmap <> API_NULL_HANDLE) Then
  54.         LoadResource = LoadBitmapIntoDC
  55.     End If
  56.     
  57. End Function
  58.  
  59. Private Function LoadBitmapIntoDC() As Boolean
  60. Dim ScreenDC As Long
  61. Dim BitmapData As BITMAP
  62.  
  63.     ' Create a compatible memory DC to hold the bitmap
  64.     ScreenDC = GetDC(API_NULL_HANDLE)
  65.     mDC = CreateCompatibleDC(ScreenDC)
  66.     ReleaseDC API_NULL_HANDLE, ScreenDC
  67.     
  68.     If (mDC <> API_NULL_HANDLE) Then
  69.         ' If the DC was created successfully,
  70.         ' select the bitmap into it
  71.         mOldBitmap = SelectObject(mDC, mBitmap)
  72.         
  73.         ' Get the dimensions of the bitmap
  74.         GDIGetObject mBitmap, Len(BitmapData), BitmapData
  75.         mWidth = BitmapData.bmWidth
  76.         mHeight = BitmapData.bmHeight
  77.         
  78.         LoadBitmapIntoDC = True
  79.     End If
  80.  
  81. End Function
  82.  
  83. Property Get Width() As Long
  84.     Width = mWidth
  85. End Property
  86.  
  87. Property Get Height() As Long
  88.     Height = mHeight
  89. End Property
  90.  
  91. Property Get hDC() As Long
  92.     hDC = mDC
  93. End Property
  94.  
  95. Public Sub Paint(DestDC As Long, _
  96.                  DestX As Long, _
  97.                  DestY As Long)
  98.     
  99.     BitBlt DestDC, DestX, DestY, _
  100.         mWidth, mHeight, mDC, _
  101.         0, 0, vbSrcCopy
  102.         
  103. End Sub
  104.  
  105. Private Sub ClearAll()
  106.     
  107.     If (mDC <> API_NULL_HANDLE) Then
  108.         If (mBitmap <> API_NULL_HANDLE) Then
  109.             ' Select the original bitmap into the DC,
  110.             ' and delete our bitmap
  111.             SelectObject mDC, mOldBitmap
  112.             DeleteObject mBitmap
  113.             mBitmap = API_NULL_HANDLE
  114.         End If
  115.         
  116.         ' Delete the memory DC
  117.         DeleteObject mDC
  118.         mDC = API_NULL_HANDLE
  119.     End If
  120.  
  121. End Sub
  122.  
  123. Private Sub Class_Terminate()
  124.     ClearAll
  125. End Sub
  126.